Prep preamble

Introduction/structure

The analyses promised are the following, in the following order:

  1. Annual change rates in life expectancy in the UK as compared with a number of other high income countries.
  2. Annual change rates in life expectancy in the UK as a whole and UK nations or groups of nations + change point analyses 2a. Life expectancy change rates 2b. Changepoint analysis
  3. ONS life expectancy projections from 2012 onwards, to show how these have been successively downrated with each biennial projection
  4. Bayes Factors for \(e_0\) changes since 2010 assuming different rates of slowdown expressed as a % of average prior change
  5. Average improvment rates for \(e_0\) implied by each ONS projection, to quantify how optimistic/pessimistic each of the projections has been compared with post 2010 trends

Let’s reorganise this material to better reflect the proposed order in the paper.

1 Annual rates of change internationally

1.1 Data

The data used were \(e_0\) from the Human Mortality Database.

The data were extracted using the HMDHFDplus package.

1.2 Results

The above should just be done once. Once extracted and saved, it should be loaded

## Parsed with column specification:
## cols(
##   country = col_character(),
##   year = col_double(),
##   sex = col_character(),
##   e0 = col_double()
## )

Let’s label the countries and pick out only mutually exclusive populations. The code lookups are here

For all mutually exclusive countries in the HMD with data since 1980 onwards, the following shows how annual life expectancy has changed over time

1.2.1 HMD Average change in \(e_0\) by decade

1.2.1.1 Figure of HMD Average change in \(e_0\) by decade

## Joining, by = c("label", "sex")

1.2.1.2 Table of HMD Average change in \(e_0\) by decade

## Joining, by = c("label", "sex")
Female
Male
Country 1980s 1990s 2000s 2010s 1980s 1990s 2000s 2010s
Australia 0.129 0.267 0.199 0.127 0.224 0.339 0.299 0.191
Austria 0.291 0.217 0.202 0.130 0.328 0.288 0.262 0.235
Belarus 0.083 -0.242 0.245 0.379 0.087 -0.454 0.248 0.613
Belgium 0.251 0.195 0.157 0.139 0.272 0.205 0.279 0.229
Bulgaria 0.112 0.019 0.223 0.126 -0.018 -0.009 0.197 0.150
Canada 0.186 0.118 0.169 0.131 0.252 0.225 0.270 0.176
Czechia 0.168 0.265 0.222 0.195 0.146 0.321 0.283 0.231
Denmark 0.064 0.113 0.215 0.250 0.090 0.222 0.263 0.301
Estonia 0.069 0.123 0.392 0.281 0.164 -0.052 0.481 0.460
Finland 0.116 0.213 0.208 0.136 0.181 0.287 0.274 0.274
France 0.251 0.185 0.190 0.109 0.256 0.249 0.281 0.211
Germany NA 0.259 0.173 0.101 NA 0.297 0.266 0.165
Greece 0.186 0.149 0.216 0.122 0.135 0.109 0.193 0.240
Hungary 0.107 0.178 0.263 0.143 -0.031 0.143 0.345 0.305
Iceland 0.003 0.127 0.223 0.040 0.302 0.133 0.222 0.091
Ireland 0.212 0.155 0.355 0.166 0.201 0.169 0.423 0.305
Israel 0.310 0.220 0.272 0.134 0.280 0.181 0.303 0.147
Italy 0.303 0.205 0.199 0.192 0.324 0.247 0.311 0.276
Japan 0.337 0.212 0.244 0.119 0.286 0.121 0.236 0.199
Latvia 0.111 -0.013 0.263 0.242 0.177 -0.114 0.332 0.286
Lithuania 0.064 0.073 0.160 0.229 0.140 -0.051 0.079 0.447
Luxembourg 0.314 0.275 0.220 0.123 0.154 0.306 0.386 0.180
Netherlands 0.086 0.053 0.221 0.067 0.136 0.167 0.321 0.191
New Zealand 0.244 0.238 0.215 0.228 0.198 0.357 0.320 0.302
Norway 0.074 0.128 0.194 0.157 0.110 0.228 0.298 0.268
Poland 0.110 0.223 0.253 0.251 0.078 0.217 0.298 0.319
Portugal 0.333 0.171 0.288 0.212 0.332 0.163 0.374 0.258
Russia 0.170 -0.207 0.236 0.340 0.312 -0.433 0.298 0.482
Slovakia 0.113 0.181 0.186 0.201 0.011 0.204 0.254 0.296
Slovenia 0.393 0.203 0.301 0.175 0.410 0.249 0.402 0.291
Spain 0.217 0.194 0.221 0.163 0.120 0.199 0.314 0.239
Sweden 0.190 0.133 0.144 0.099 0.222 0.229 0.227 0.174
Switzerland 0.231 0.154 0.171 0.150 0.203 0.272 0.285 0.271
Taiwan 0.216 0.216 0.335 0.170 0.181 0.173 0.292 0.138
Ukraine 0.126 -0.158 0.124 0.338 0.168 -0.352 0.174 0.490
United Kingdom 0.168 0.168 0.244 0.091 0.230 0.229 0.316 0.164
USA 0.120 0.079 0.165 0.047 0.180 0.232 0.217 0.029
Note:
Average annual change in life expectancy by decade, sex, and country

NA: Not Available

The countries with the fastest average improvement in \(e_0\) in the 2010s include Belarus (0.38 years/year for females, 0.61 years/year for males), Ukraine (0.34 females, 0.49 males), Russia (0.34 females, 0.48 males), Lithuania (0.23 females, 0.45 males), and Poland (0.25 females, 0.32 males). By contrast, the countries with the slowest improvements in the 2010s include the USA (0.05 females, 0.03 males), Iceland (0.04 females, 0.09 males), the United Kingdom (0.09 females, 0.16 males), Netherlands (0.07 females, 0.19 males), and Germany (0.10 females, 0.17 males). With the exception of the USA, there is still a tendency for improvements in the 2010s to be somewhat faster for males than females. The fastest-improving countries also tended to experience the slowest rates of improvement, or severe deteriorations (worsenings), in life expectancy change in the 1990s.

The similarity between average rates of improvement in the 2010s in Germany and the UK is noteworthy with average sex specific improvement rates within 0.01 years per year of each other (0.09 compared with 0.10 for females in the UK and Germany respectively; 0.16 compared with 0.17 for males). The German data covers 2010-2017 inclusive, whereas for the UK the data extends to 2016.

1.2.1.3 Annual change in slow gainers since 1980

There are some important differences, however, in how annual change rates have varied in the the slowest-improving countries. Figure X shows this for the five slowest-improving countries excluding Iceland, which due to its small population size shows much greater levels of annual variability than the other countries. From this figure it is apparent that the USA not only tended to show lower rates of improvement before 2010, but has also been exhibiting continuing and more persistent declines than the other countries, with three consecutive years of declining mortality for males in the last three available years, and only modest improvements for females.

2 Annual change rates in life expectancy in the UK as a whole and UK nations or groups of nations + change point analyses

The previous section used data from the HMD, comparing the UK as a whole against other countries in the HMD. The last year available for the UK in the HMD was 2016. More recent \(e_0\) estimates are available from the ONS, which also provides estimates disaggregated by country and group of countries within the UK. We will use this data to explore how (dis)similar the trends in life expectancy change have been within different UK nations/groups of nations.

2.1 Data

We’ll now use the tables from this location to get \(e_0\), \(m_x\) and related lifetable quantities from a single source, for each UK nation.

First, I’ve downloaded each of the single year files to the data directory.

2.1.1 Data preparation

The following code will not be run, as the data have already been extracted. However it is kept here for completeness.

First, defining the files to extract lifetables from.

Then, defining a function to clean the data from the worksheets in the workbooks.

Now, getting the \(m_x\) data.

Now, extracting the lifetables in a tidy format.

From this it’s very easy to extract \(e_0\) alone.

To save on this, let’s just load the tidied \(e_0\) data

## Parsed with column specification:
## cols(
##   population = col_character(),
##   year = col_double(),
##   sex = col_character(),
##   e0 = col_double()
## )

2.2 Analysis

2.2.1 Change in life expectancy in UK nations and groups of nations

2.2.1.1 Figure of change in life expectancy in UK nations and groups of nations

Visualise the life expectancy and change in life expectancy for each year

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

From the above it seems most populations have seen a slowdown in improvement in recent years, and on average relatively stable improvements previously, with the exception of Northern Ireland, which saw a slowdown in improvement in the 1980s. The smaller populations tend to exhibit greater variability in annual rates of change than the larger populations. The extent of oscillation (negative autocorrelation from one year to the next) also appears greater in smaller populations. It is not immediately clear that the breakpoint for the slowdown is the same for all UK populations.

2.2.2 Average change by decade

As before, let’s look at the average improvement per decade. This will allow us to compare the UK rates from the ONS against those in the HMD.

ons_ch_e0_decade <- 
  dta_e0 %>% 
    group_by(population, sex) %>% 
    arrange(year) %>% 
    mutate(ch_e0 = e0 - lag(e0)) %>% 
    ungroup() %>% 
    mutate(
      population = fct_relevel(population, c("United Kingdom", "Great Britain", "England & Wales", "England", "Scotland", "Wales", "Northern Ireland"))
    ) %>% 
    filter(!is.na(ch_e0)) %>% 
    select(-e0) %>% 
    mutate(
        decade = case_when(
          between(year, 1980, 1989)      ~ "1980s",
          between(year, 1990, 1999)      ~ "1990s",
          between(year, 2000, 2009)      ~ "2000s",
          between(year, 2010, 2020)      ~ "2010s",
          TRUE                           ~ NA_character_
      )
    ) %>% 
    group_by(population, sex, decade) %>% 
    summarise(mean_ch_e0 = mean(ch_e0, na.rm = TRUE)) %>% 
    ungroup() 

ons_ch_e0_decade

As expected, the ONS and HMD estimates of mean improvement per decade are closely aligned, usually within two decimal places, though are somewhat lower in the 2010s for ONS than for HMD:

sex decade HMD ONS
f 80s 0.168 0.168
f 90s 0.168 0.170
f 00s 0.244 0.241
f 10s 0.091 0.080
m 80s 0.229 0.230
m 90s 0.229 0.232
m 00s 0.319 0.313
m 10s 0.164 0.131

Let’s now present this as a barplot

## Joining, by = c("population", "sex")

For each UK nation, the 2000s had exceptionally high rates of improvement. By contrast the 2010s are exceptionally low. Within Northern Ireland, there was an exceptionally high rate of improvement in the 1980s. Rates of improvement in the 2000s have been higher in the 2000s in males than females.

2.2.3 Change in life expectancy in mutually exclusive UK nations

2.2.3.1 Change in life expectancy in mutually exclusive UK nations - faceted

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

2.2.3.2 Change in life expectancy in mutually exclusive UK nations - overlaid

There are clear similarities between the trends in each of the UK nations, again with the exception of Northern Ireland. The trends even seem to correspond in terms of which years are ‘good years’ and which years are ‘bad years’ (i.e. they oscillate in phase with each other). To check this let’s look at the correlation between the trends.

corrs_trends <- 
  dta_e0 %>% 
    filter(population %in% c("England", "Wales", "Scotland", "Northern Ireland")) %>% 
    group_by(population, sex) %>% 
    arrange(year) %>% 
    mutate(ch_e0 = e0 - lag(e0)) %>% 
    ungroup() %>% 
    filter(!is.na(ch_e0)) %>% 
    select(-e0) %>% 
    unite(col = "pop_sex", population, sex) %>% 
    spread(pop_sex, ch_e0) %>% 
    select(-year) %>% 
    correlate() 
## 
## Correlation method: 'pearson'
## Missing treated using: 'pairwise.complete.obs'
corrs_trends
corrs_trends %>% 
  rplot() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
## Don't know how to automatically pick scale for object of type noquote. Defaulting to continuous.

corrs_trends %>% 
  network_plot()

Trends in males and females in England are highly correlated (r = 0.89). The correlation between male and female trends in Wales are also strong (r = 0.77), which is slightly below the correlation between females in England and Wales (r = 0.81). Correlations between males and females in Scotland are slightly weaker (r = 0.67), and the associations between sexes are weakest in Northern Ireland (r = 0.55).

The network plot places series that are more correlated with each other closer together, and less correlated series further from each other. This confirms that males’ and females’ trends are closely correlated to each other in England and Wales, somewhat less so in Scotland, and least in Northern Ireland, where trends between sexes are less correlated with each other than are the correlations between countries elsewhere in the UK.

This suggests that any general trends which apply throughout the UK will apply less strongly in Northern Ireland than elsewhere. This should be considered when looking at the results in the next section, which aims to identify if and when there have been breakpoints in the trends in UK nations.

2.2.4 Breakpoint analysis

The following section will perform breakpoint analysis using the segmented package for each UK nation as well as the UK as a whole.

First we look to see if two and three breakpoints can be identified in any of the populations.

In many cases, breakpoints cannot be identified. However this may be if multiple breakpoints are being attempted, but not all can be estimated. We are mainly interested in whether there’s been a single breakpoint, and whether this has been identified consistently in all populations.

To investigate this, let’s explore whether the same single breakpoint can be consistently identified. We can do that by checking whether the choice of random number seed matters.

Note that consecutive random numbers cannot be used, as for some random numbers (4, 5 and 7 in this case) breakpoints cannot be identified.

Let’s pull the 1 breakpoint estimates

  • Note: For some reason this currentl doesn’t run. I’m not sure of the reasons so this needs to be fixed at some point.

This shows that 1 breakpoint models can be identified for each population, but 2 and 3 breakpoint models only for some populations. For almost all populations, except Northern Ireland, the breakpoint is identified as around 2009 (so the change from 2009 to 2010)

2.2.4.1 Breakpoint figure

The following shows the breakpoints and standard errors.

2.2.4.2 Breakpoint table

This shows a lot of consistency in estimates of when the breakdown occurred. With the exception of Northern Ireland, we can use 2010 afterwards as ‘post-slowdown’, and the years from 1980 onwards as ‘pre-slowdown’.

Population Sex Breakpoint SE Lower CI Upper CI
England female 2009.00 5.15 1998.70 2019.30
England male 2009.93 2.34 2005.26 2014.60
Northern Ireland female 1985.00 5.13 1974.73 1995.27
Northern Ireland male 1983.00 1.92 1979.16 1986.84
Scotland female 2009.87 4.95 1999.97 2019.77
Scotland male 2010.45 3.05 2004.36 2016.54
Wales female 2009.00 6.80 1995.40 2022.60
Wales male 2010.00 4.43 2001.14 2018.86
England & Wales female 2009.00 5.25 1998.49 2019.51
England & Wales male 2009.92 2.35 2005.22 2014.63
Great Britain female 2009.00 5.26 1998.48 2019.52
Great Britain male 2009.98 2.29 2005.41 2014.56
United Kingdom female 2009.00 5.35 1998.30 2019.70
United Kingdom male 2009.95 2.39 2005.18 2014.72

2.2.4.3 Breakpoint figure - mutually exclusive UK nations

The following shows the breakpoints and standard errors.

2.2.4.2 Breakpoint table

This shows a lot of consistency in estimates of when the breakdown occurred. With the exception of Northern Ireland, we can use 2010 afterwards as ‘post-slowdown’, and the years from 1980 onwards as ‘pre-slowdown’.

Population Sex Breakpoint SE Lower CI Upper CI
England female 2009.00 5.15 1998.70 2019.30
England male 2009.93 2.34 2005.26 2014.60
Northern Ireland female 1985.00 5.13 1974.73 1995.27
Northern Ireland male 1983.00 1.92 1979.16 1986.84
Scotland female 2009.87 4.95 1999.97 2019.77
Scotland male 2010.45 3.05 2004.36 2016.54
Wales female 2009.00 6.80 1995.40 2022.60
Wales male 2010.00 4.43 2001.14 2018.86
England & Wales female 2009.00 5.25 1998.49 2019.51
England & Wales male 2009.92 2.35 2005.22 2014.63
Great Britain female 2009.00 5.26 1998.48 2019.52
Great Britain male 2009.98 2.29 2005.41 2014.56
United Kingdom female 2009.00 5.35 1998.30 2019.70
United Kingdom male 2009.95 2.39 2005.18 2014.72

2.2.4.2 Effect of different random number seeds on breakpoint

Let’s do the same for the five one breakpoint models using different seeds

Break point years, where they can be calculated, are largely identical. They confirm 2010 as a reasonable breakpoint year except for Northern Ireland.

  1. ONS life expectancy projections from 2012 onwards, to show how these have been successively downrated with each biennial projection

3 ONS life expectancy projections

The ONS modifies their estimates of life expectancy every couple of years as part of their population projections exercise. For the last four projections the life expectancy projections have been downgraded. This section will show how projections have changed over time, and how they compare against observed life expectancy.

3.1 Data

For Scotland, the data for the projections are made available at this location on the ONS website:

The specific projections are available at the following locations:

For England, the projections are available here.

For Wales, the projections are available here.

For Northern Ireland, the projections are available here

The for United Kingdom, the projections are available here

3.1.2 Load all data from separate sheets

Now to start loading all in a tidy way

Now to load all sheets

3.1.3 Tidy and combine all projection data

Now tidying, gathering, and combining

Just load it

ons_projections_tidied <- read_rds(here("data", "ons_projections", "all_tidied.rds"))

3.2 Visualise projections

3.2.1 Change in projections

How do the projections (e0 at birth) change over time between countries?

ons_projections_tidied %>% 
  filter(age == 0) %>% 
  filter(year >= 2010) %>% 
  mutate(proj_year = factor(proj_year)) %>% 
  mutate(country = factor(country, levels = c("UK", "England", "Northern Ireland", "Scotland", "Wales"))) %>% 
  ggplot(aes(x = year, y = ex, group = proj_year, colour = proj_year)) + 
  facet_grid(country ~ sex) +
  geom_line() +
  labs(
    x = "Year", y = "Life expectancy at birth (years)",
    title = "ONS projections for life expectancy at birth",
    colour = "ONS Projection\nYear"
  ) 

ggsave(here("figures", "ons_life_expectancy_projections.png"), height = 25, width = 20, units = "cm", dpi = 300)

3.2.2 Change in projections - annual increases

For each of these projections, what’s the implied expected improvement level?

ons_projections_tidied %>% 
  filter(age == 0) %>% 
  filter(year >= 2019) %>% 
  group_by(sex, country, proj_year) %>% 
  arrange(year) %>% 
  mutate(ch_e0 = ex - lag(ex)) %>% 
  filter(!is.na(ch_e0)) %>% 
  ggplot(aes(x = year, y = ch_e0, group = factor(proj_year), colour = factor(proj_year), shape = factor(proj_year))) + 
  geom_point() + geom_line() +
  facet_grid(country ~ sex) +
  geom_hline(yintercept = 0) + 
  labs(
    x = "Year", y = "Change in Life expectancy at birth (years)",
    title = "ONS projections for annual life expectancy change at birth",
    colour = "ONS Projection\nYear", 
    shape = "ONS Projection\nYear" 
  ) 

ggsave(here("figures", "ons_life_expectancy_projections_change.png"), height = 25, width = 25, units = "cm", dpi = 300)

So, the projections involve adding varying numbers of increments of 0.1 life expectancy gain per year. Values within these intervals are created by changing the numbers of years of 0.2, 0.1 and 0.0 gain.

3.2.3 Projections at all ages

ons_projections_tidied %>%
  filter(sex == "m") %>%
  mutate(country = factor(country, levels = c("UK", "England", "Wales", "Scotland", "Northern Ireland"))) %>% 
  mutate(proj_year = factor(proj_year)) %>% 
  ggplot(aes(x = year, y = age, fill = ex)) + 
  geom_tile() + 
  scale_fill_viridis_c() + 
  coord_fixed() + 
  facet_grid(country ~ proj_year) + 
  labs(
    x= "Year", y = "Age in years", 
    title = "Projected life expectancy by ONS projection year and country, Males"
  )

ggsave(here("figures", "ons_projections_lexis_males.png"), height = 30, width = 25, units = "cm", dpi = 300)
ons_projections_tidied %>%
  filter(sex == "f") %>%
  mutate(country = factor(country, levels = c("UK", "England", "Wales", "Scotland", "Northern Ireland"))) %>% 
  mutate(proj_year = factor(proj_year)) %>% 
  ggplot(aes(x = year, y = age, fill = ex)) + 
  geom_tile() + 
  scale_fill_viridis_c() + 
  coord_fixed() + 
  facet_grid(country ~ proj_year) + 
  labs(
    x= "Year", y = "Age in years", 
    title = "Projected life expectancy by ONS projection year and country, Females"
  )

ggsave(here("figures", "ons_projections_lexis_females.png"), height = 30, width = 25, units = "cm", dpi = 300)

3.2.4 Change in projections at all ages

ons_projections_tidied %>% 
  group_by(country, sex, age, year) %>% 
  arrange(proj_year) %>% 
  mutate(ch_ex_proj = ex - lag(ex)) %>% 
  filter(!is.na(ch_ex_proj)) %>% 
  ungroup() %>% 
  mutate(country = factor(country, levels = c("UK", "England", "Wales", "Scotland", "Northern Ireland"))) %>% 
  filter(year >= 2020) %>% 
  filter(sex == "m") %>% 
  ggplot(aes(x = year, age, fill = ch_ex_proj)) + 
  geom_tile() + 
  coord_fixed() + 
  facet_grid(country ~ proj_year) +
  scale_fill_distiller(palette = "RdBu", limits = c(-1.5, 1.5)) + 
  labs(
    x = "Year", y = "Age in years", fill = "Change in ex",
    title = "Change in conditional life expectancy from previous ONS projection, male"
  ) +
  theme(axis.text.x = element_text(angle = 90))

ggsave(here("figures", "change_ons_projections_males.png"), height = 40, width =20, units = "cm", dpi = 300)


ons_projections_tidied %>% 
  group_by(country, sex, age, year) %>% 
  arrange(proj_year) %>% 
  mutate(ch_ex_proj = ex - lag(ex)) %>% 
  filter(!is.na(ch_ex_proj)) %>% 
  ungroup() %>% 
  mutate(country = factor(country, levels = c("UK", "England", "Wales", "Scotland", "Northern Ireland"))) %>% 
  filter(year >= 2020) %>% 
  filter(sex == "f") %>% 
  ggplot(aes(x = year, age, fill = ch_ex_proj)) + 
  geom_tile() + 
  coord_fixed() + 
  facet_grid(country ~ proj_year) +
  scale_fill_distiller(palette = "RdBu", limits = c(-1.5, 1.5)) + 
  labs(
    x = "Year", y = "Age in years", fill = "Change in ex",
    title = "Change in conditional life expectancy from previous ONS projection, female"
  ) +
  theme(axis.text.x = element_text(angle = 90))

ggsave(here("figures", "change_ons_projections_females.png"), height = 40, width =20, units = "cm", dpi = 300)

3.3 Summaries

3.3.1 Average projected improvement

Let’s summarise this:

ons_projections_summarised <- 
  ons_projections_tidied %>% 
    filter(age == 0) %>% 
    filter(year >= 2019) %>% 
    group_by(sex, country, proj_year) %>% 
    arrange(year) %>% 
    mutate(ch_e0 = ex - lag(ex)) %>% 
    summarise(
      mean_ch_e0 = mean(ch_e0, na.rm = TRUE),
      sd_ch_e0   = sd(ch_e0, na.rm = TRUE  )
    ) 

ons_projections_summarised

At this point let’s compare the ONS projections against the historic values observed since 1990

sex decade HMD ONS
f 80s 0.168 0.168
f 90s 0.168 0.170
f 00s 0.244 0.241
f 10s 0.091 0.080
m 80s 0.229 0.230
m 90s 0.229 0.232
m 00s 0.319 0.313
m 10s 0.164 0.131
sex 2012 2014 2016 2018
f 0.137 0.129 0.115 0.094
m 0.148 0.147 0.134 0.114

So, the projections have all assumed that the rates of improvement observed in the 2000s are not sustainable in the long term, but have been downrated by around a third from 2012 to 2018 for females, and by around a fifth from 2012 to 2018 for males. Assumed rates of improvement are around 17.5% higher than observed in the 2010s for females, and around 13% higher than observed in the 2010s for males.

To put more simply: the 2012 ONS projection assumed the rate of improvement would be the midpoint between the 1990 and 2010-11 rates, and subsequent projections have tended increasingly towards the post 2010 improvement levels. They have largely been responsive to the new and much slowed life expectancy gains.

The before period used in the Bayes Factor calculations before is 1991 onwards. Let’s identify what the average improvement was over this period.

dta_e0 %>% 
  filter(population == "United Kingdom") %>% 
  filter(between(year, 1990, 2010)) %>% 
  group_by(sex) %>% 
  arrange(year) %>% 
  mutate(ch_e0 = e0 - lag(e0)) %>% 
  filter(!is.na(ch_e0)) %>% 
  summarise(mean_ch_e0  = mean(ch_e0), var_ch_e0 = var(ch_e0)) %>% 
  kable(digits = 3) %>% 
  kable_styling()
sex mean_ch_e0 var_ch_e0
female 0.191 0.039
male 0.276 0.026

This checks out with what I’ve calculated before. (Phew!)

3.3.1.1 Average projected improvement - visualised

ons_projections_summarised %>%
  ungroup() %>% 
  mutate(country = factor(country, levels = c("UK", "England", "Scotland", "Northern Ireland", "Wales"))) %>% 
  ggplot(aes(x = proj_year, y = mean_ch_e0)) +
  geom_point() + 
  geom_errorbar(aes(ymin = mean_ch_e0 - 2 * sd_ch_e0, ymax = mean_ch_e0 + 2 * sd_ch_e0), width = 0) +
  geom_hline(yintercept = 0) +
  facet_grid(sex ~ country) +
  expand_limits(y = 0) +
  labs(
    x = "Year of projection", 
    y = "Mean projected change in life expectancy (years / year)",
    title = "Comparison between life expectancy improvements assumed in different ONS projections",
    caption = "Source: ONS Population Projections"
  )

ggsave(here("figures", "ons_proj_assumed_e0_gain.png"), height = 20, width = 30, units = "cm", dpi = 300)

4 Bayes Factors

  1. Bayes Factors for \(e_0\) changes since 2010 assuming different rates of slowdown expressed as a % of average prior change

5 Bayes Factors against ONS projections

  1. Average improvment rates for \(e_0\) implied by each ONS projection, to quantify how optimistic/pessimistic each of the projections has been compared with post 2010 trends

===========

Now, let’s determine the average change (and SD) from 1980 to 2010

dta_e0 %>% 
  group_by(population, sex) %>% 
  arrange(year) %>% 
  mutate(ch_e0 = e0 - lag(e0)) %>% 
  ungroup() %>% 
  filter(!is.na(ch_e0)) %>%
  filter(year < 2010) %>% 
  select(-e0) %>% 
  group_by(population, sex) %>% 
  arrange(year) %>% 
  summarise(
    mean_ch = mean(ch_e0),
    sd_ch   = sd(ch_e0)   
  ) %>% 
  write_to_table(here("data", "mean_sd_ch_preslowdown_ons.csv")) %>% 
  mutate(mean_ch = mean_ch * 52.25, sd_ch = sd_ch * 52.25) %>% 
  ggplot(aes(x = mean_ch, y = sd_ch, shape = sex, colour = sex)) + 
  geom_point() + 
  geom_text_repel(aes(label = population, colour = sex), show.legend = FALSE) + 
  labs(
    x = "Mean annual change in life expectancy in weeks",
    y = "Standard deviation in annual change in life expectancy in weeks", 
    title = "Mean and standard deviation of change in life expectancy\nfrom 1980 to 2010 by UK population",
    caption = "Source: ONS Single Year Lifetables"
  ) +
  

ggsave(here("figures", "mean_sd_preslowdown_improvement_ons.png"), height = 20, width = 20, units = "cm", dpi = 300)

For each of these populations, we can estimate the relative likelihood of observing the observed life expectancies from 2011 onwards under the assumption that each population’s fundamentals of life expectancy improvement had not changed after 2010. This assumption is questionable for Northern Ireland because of its changepoint in the mid 1980s, but will be applied to this population too for consistency with the other populations.

bf_uk_nations <- 
  dta_e0 %>% 
    group_by(population, sex) %>% 
    arrange(year) %>% 
    mutate(ch_e0 = e0 - lag(e0)) %>% 
    ungroup() %>% 
    filter(!is.na(ch_e0)) %>%
    select(-e0) %>% 
    group_by(population, sex) %>% 
    arrange(year) %>% 
    nest() %>% 
    crossing(after_end = 2011:2018) %>% 
    mutate(
      bayes_df = map2(
        after_end, data, ~calc_bayes_factors(after_period = c(2011, .x), before_period = c(1991, 2010), outcome_var = ch_e0, dta = .y)
      )
    ) %>% 
    select(population, sex, after_end, bayes_df) %>% 
    unnest(cols = c(bayes_df)) %>% 
    mutate(
      period = paste0("2011-", str_sub(after_end, 3,4))
    ) 

bf_uk_nations
bf_uk_nations %>% 
  mutate(perc = 100 * perc) %>% 
  mutate(
    population = fct_relevel(population, c("United Kingdom", "Great Britain", "England & Wales", "England", "Scotland", "Wales", "Northern Ireland"))
  ) %>% 
  ggplot(aes(x = perc, y = bayes_factor, alpha = period)) +
  geom_line() + 
  geom_line(aes(x = perc, y = bayes_factor), size = 1.4, 
              data = bf_uk_nations %>% 
                filter(period == "2011-18") %>% 
                mutate(perc = 100 * perc) %>%
                mutate(
    population = fct_relevel(population, c("United Kingdom", "Great Britain", "England & Wales", "England", "Scotland", "Wales", "Northern Ireland"))
  ) %>% 
                mutate(is_pos = bayes_factor > 1),
              inherit.aes = FALSE
            ) + 
  facet_wrap(population ~ sex, scales = "free_y") +
  geom_ribbon(aes(
      ymin = ifelse(is_pos, 1, bayes_factor), 
      ymax = ifelse(is_pos, bayes_factor, 1), 
      x = perc, group = paste0(is_pos, period),
      fill = is_pos
    ), 
              data = bf_uk_nations %>% 
                mutate(perc = 100 * perc) %>%
                  mutate(
              population = fct_relevel(population, c("United Kingdom", "Great Britain", "England & Wales", "England", "Scotland", "Wales", "Northern Ireland"))
            ) %>% 
                mutate(is_pos = bayes_factor > 1),
              inherit.aes = FALSE, alpha = 0.2) + 
  # scale_y_continuous(limits = c(0.999, 1.008), 
  #                    breaks = seq(0.999, 1.0080, by = 0.001)
  #                      
  #                      ) +
  scale_alpha_discrete("Period", range = c(0.2, 1), breaks = c("2011-11", "2011-12", "2011-13", "2011-14", "2011-15", "2011-16", "2011-17", "2011-18")) +
  geom_hline(yintercept = 1) + 
  labs(
    x = "Percentage of previous improvement",
    y = "Bayes Factor\n(>1 means support for Alternative Hypothesis",
    title = "Bayes Factor for various proposed levels of slowdown",
    subtitle = "Based on all series up to 2011-18"
  ) +
  guides(fill = FALSE) +
  scale_x_continuous(breaks = seq(0, 100, by = 10))
## Warning: Using alpha for a discrete variable is not advised.

ggsave(here("figures", "bayes_factor_various_proposed_slowdown_levels.png"), height = 12, width = 12, units = "in", dpi = 300)

For all populations except males in Northern Ireland, the addition of the 2018 single year life expectancy data led to sizeable increases in the empirical support for the belief that there has been a slowdown in life expectancy after 2010; this is seen by noting how much higher the bold line, which incorporates the 2018 data, is than the fainter lines representing cumulative data based on shorter series of observations. For most of these populations, the peak of the bold line is to the left of peaks based on earlier series, meaning not only did the 2018 observations increase the strength of evidence supporting belief in a slowdown in life expectancy improvements, but also suggested more severe magnitudes of slowdown than the series excluding this most recent observation had indicated. For the UK as a whole, the addition of the life expectancy data for 2018 suggested an overall slowdown of around 60% was most likely, compared with a most likely magnitude of slowdown of around 50% based on data up to 2017. For each of these populations, what does the Bayes Factor maximise at?

bf_uk_nations %>% 
   filter(period == "2011-18") %>% 
   mutate(perc = 100 * perc) %>%
   mutate(
    population = factor(population, levels = rev(c("United Kingdom", "Great Britain", "England & Wales", "England", "Scotland", "Wales", "Northern Ireland")))
  ) %>% 
  group_by(sex, population) %>% 
  filter(bayes_factor == max(bayes_factor)) %>% 
  ungroup() %>% 
  ggplot(aes(y = population, x = 100 - perc, shape = sex, colour = sex)) + 
  geom_point() + 
  labs(
    x = "Percentage decline from 1980-2011 levels",
    y = "Population", 
    title = "Estimated percentage decline in life expectancy improvement rates over 2011-2018 compared with 1981-2010"
  ) +
  lims(x = c(0, 100))

And as a table

bf_uk_nations %>% 
   filter(period == "2011-18") %>% 
   mutate(perc = 100 * perc) %>%
   mutate(
    population = factor(population, levels = rev(c("United Kingdom", "Great Britain", "England & Wales", "England", "Scotland", "Wales", "Northern Ireland")))
  ) %>% 
  group_by(sex, population) %>% 
  filter(bayes_factor == max(bayes_factor)) %>% 
  ungroup() %>% 
  select(population, sex, perc, bayes_factor) %>% 
  mutate(perc = 100 - perc)

In the UK as a whole, it is most likely that life expectancy improvement rates have slowed down by 62% for females, and 59% for males. This is made up of a 60% (females) and 59% (males) slowdown in England, a 72% (females) and 56% (males) slowdown in Scotland, a 59% (females) and 29% (males) slowdown in Northern Ireland, and an estimated 77% (females) and 83% (males) slowdown in Wales. With the exception of males in Northern Ireland, rates of slowdown are therefore similar across UK nations, and generally slightly more severe for females than males.

Some important points:

Let’s now compare the values that maximise the Bayes factor against the ONS population projections:

Year BF- female BF- male ONS- female ONS- male
2011-2012 0.161 0.276 0.137 0.148
2011-2014 0.163 0.218 0.129 0.147
2011-2016 0.088 0.138 0.115 0.134
2011-2018 0.075 0.108 0.094 0.114

So, up to 2014, the ONS was projecting a slower improvement rates than 2011-12 alone would suggest. For the 2016 and 2018 projections, the rates were slightly higher than the Bayes Factor alone would suggest, especially for females. Now, the remaining analysis (possibly the only remaining analysis) is to express the UK’s recent improvmeent rates and ONS projections as a % of the mean improvement from 1980 to 2010.

mean_lt_imp_uk <-
  dta_e0 %>% 
    filter(population == "United Kingdom") %>%
    filter(between(year, 1980, 2011)) %>% 
    group_by(sex) %>% 
    arrange(year) %>% 
    mutate(ch_e0 = e0 - lag(e0)) %>% 
    summarise(
      mean_ch_e0 = mean(ch_e0, na.rm = TRUE), 
      var_ch_e0 = var(ch_e0, na.rm = TRUE)
    )

mean_lt_imp_uk_female <- mean_lt_imp_uk %>% filter(sex == "female") %>% pull(mean_ch_e0)
mean_lt_imp_uk_male <- mean_lt_imp_uk %>% filter(sex == "male") %>% pull(mean_ch_e0)

mean_lt_imp_uk

So, by 2012 the ONS was projecting future improvmeent rates that were around 30% lower (1 - 0.137 / 0.197) than long-term average improvement rates for females, and around 44% lower than long-term trends (1 - 0.148 / 0.265) for males. By contrast the Bayes Factor approach alone would predict slowdowns of around 18% for females, and gains of around 4% for males.

By 2014 the ONS was projecting slowdowns of around 35% for females, and 44% for males. This contrasts with Bayes Factor estimates of around a

est_as_pct_of_lt <- 
  tribble(
    ~Year, ~BF_female, ~BF_male, ~ONS_female, ~ONS_male,
    "2011-12", 0.161, 0.276, 0.137, 0.148,
    "2011-14", 0.163, 0.218, 0.129, 0.147, 
    "2011-16", 0.088, 0.138, 0.115, 0.134, 
    "2011-18", 0.075, 0.108, 0.094, 0.114
  ) %>% 
    gather(-Year, key = "method_sex", value = "ch_e0") %>% 
    separate(method_sex, into = c("method", "sex")) %>% 
    left_join(
      tribble(
        ~sex, ~lt_ch_e0,
        "female", mean_lt_imp_uk_female,
        "male", mean_lt_imp_uk_male
      )
    ) %>% 
    mutate(
      new_as_pct = ch_e0 / lt_ch_e0
    ) %>% 
    select(-ch_e0, -lt_ch_e0) 
## Joining, by = "sex"
est_as_pct_of_lt %>% 
  unite(method, sex, col = "method_sex") %>% 
  spread(method_sex, new_as_pct) %>% 
  kable(digits = 3) %>% 
  kable_styling()
Year BF_female BF_male ONS_female ONS_male
2011-12 0.816 1.040 0.694 0.557
2011-14 0.826 0.821 0.653 0.554
2011-16 0.446 0.520 0.583 0.505
2011-18 0.380 0.407 0.476 0.429

And as a graph

est_as_pct_of_lt %>% 
  ggplot(aes(x = Year, y = new_as_pct, group = method, shape = method, colour = method)) +
  geom_point() + geom_line() +
  facet_wrap(~sex) +
  expand_limits(y = 0) + 
  geom_hline(yintercept = 1) +
  labs(x = "Projection Year", y = "New LT improvement as proportion of long-term trends")

So, it appears the ONS, and the experts who advised them, believed that the long-term improvement trends were unsustainable from 2011 onwards, and projected trends that were slower than the average improvement rates seen between 1980 and 2011. However, each successive biennial update has projected a slower rate of improvement than the previous projection. The Bayes Factor approach, with the accumulated data from 2011 to 2018, suggests the ONS projections are largely in line with recent data for males, but may still be underestimating the extent of the stalling in life expectancy gains for females.

An advantage of the Bayes Factor approach is that it is trivial to update it every year, taking only a minute or so to rerun with an additional year’s worth of data. This means that as soon as new data becomes available, it can be used to update our beliefs about long-term trends, and the extent of the deterioration from long-term trends if the accumulated recent data is considered representive of how long-term trends are likely to progress.

Scrapbook

International comparison

Let’s look at how the UK compares with a small selection of other nations. For this international comparison, data from the [Human Mortality Database] will be used. These data are not as up-to-date as those produced by the ONS in their single year lifetables, and are more out-of-date for some countries than others.

How has life expectancy changed in each of these populations since 1980?

hmd_e0 %>% 
  filter(sex == "total") %>% 
  filter(country %in% c("CAN", "USA", "DEUTNP", "NLD", "FRATNP", "GBR_NP", "JPN", "RUS", "NOR", "AUS", "FIN", "ITA")) %>% 
  group_by(country) %>% 
  arrange(year) %>% 
  mutate(ch_e0 = e0 - lag(e0)) %>% 
  filter(year >= 1980) %>% 
  ungroup() %>% 
  mutate(ch_e0 = 52.25 * ch_e0) %>% 
  ggplot(aes(x = year, y = ch_e0)) +
  stat_smooth() +
  geom_point() + geom_line() + 
  facet_wrap(~country, scales = "free_y") + 
  geom_hline(yintercept = 0) +
  labs(
    x = "Year", y = "Change in life expectancy from previous year (weeks)",
    title = "Annual change in period life expectancy, selected high income countries",
    caption = "Source: HMD"
  )
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
## Warning: Removed 1 rows containing non-finite values (stat_smooth).
## Warning: Removed 1 rows containing missing values (geom_point).

ggsave(here("figures", "all_countries_hmd.png"), height = 20, width = 28, units = "cm", dpi = 300)
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
## Warning: Removed 1 rows containing non-finite values (stat_smooth).

## Warning: Removed 1 rows containing missing values (geom_point).

This gives some pause for thought. Countries that have seen a slowdown in life expectancy improvement in recent years include:

  • The USA (most severe)
  • The UK
  • The Netherlands
  • France
  • Canada
  • Australia
  • Germany (least severe)

Note a difference scale is used for each country, mainly due to the high annual variation in Russia, which saw a sudden decline in life expectancy, of around four years in the years following the collapse of the USSR. With the exception of Russia, and France and Italy in 2003-4 (discussed next), the scales for other populations are quite similar. Note that Italy’s population data submitted to the HMD are less recent than for the other European countries, and more up-to-date data may also suggest a slowdown in Italy as well.

Note also a very high annual increase in life expectancy from 2003-2004, in the following countries:

  • France
  • Italy
  • the UK (to a lesser extent)
  • Norway (to a lesser extent)
  • The USA (to a lesser extent)

In France this gain was of around 40 weeks. This appears to correspond to an exceptionally mild winter in 2003-2004, apparently the mildest in around 50 years according to this paper. It is more than conceivable that this phenomena will lead to some mortality displacement in subsequent years, though I expect any such effect to be transient and not to be sufficient to explain the long-term slowdown observed in the first list of countries above.

Within Murphy’s LSE Working Paper on mortality trends, breakpoint analysis was performed for a number of high income countries. This identified a breakpoint of around 2010 in the UK, but around 2005 in some other European countries. (See Figure 4 or report) Further descriptive statistics breaking down mortality change rates by whether the deaths were attributed to cardiovascular disease (i.e. CVD mortality, non-CVD mortality, and total mortality: See Figure 14) also indicated a turning point in cardiovascular disease death rates from 2005 onwards, in France, the Netherlands, and the UK. To the extent that CVD is seasonally patterned and a predominant cause of mortality, and that an outlier value could lead the breakpoint analysis algorithm to split the series into before and after the outlier, it appears conceivable that the finding of a turning point in mortality of around 2005, as identified in a number of European populations, could be in part an artefact of the mild 2003-4 winter. (However, as Figure 14 is not based on a breakpoint analysis, but SDRs alone, and shows that CVD SDR improvement rates have continued to decline for many years post 2005, artefact alone is unlikely to be the main explanation for the series.)